 PAG
********************
* SFOURFONE
********************
 ORG $C800

*************** MESSAGES *************

* MESSAGE FOR SKIP

MSGSKIP ASC "SKIP"
 DFB CR,EOT 

* MESSAGE FOR COMDKEY

MSGKEY DFB CR
 ASC "KEY = "
 DFB EOT

MSGBROUT
 DFB CR
 ASC "BRANCH OUT OF RANGE"
 DFB BEL,CR,EOT

MSGNOTRM
 DFB CR
 ASC "**ACCESS ERROR**"
 DFB BEL,CR,EOT

MSGHARD DFB CR
 ASC "HARD BREAK"
 DFB CR,EOT

MSGORNG DFB CR
 ASC "OUTSIDE RANGE LIMITS"
 DFB BEL,CR,EOT

MSGNOAC DFB CR
 ASC "NO ACCESS HALT"
 DFB BEL,EOT

* DISPLAY TABLE, FORMAT- ASCII, LOW BYTE OF SWITCH(S) ADDRS

DISPTABL
 DFB "1",$54+$80
 DFB "2",$55+$80
 DFB "4",$0C+$80
 DFB "8",$0D+$80
 DFB "T",$5F,$51+$80
 DFB "A",$0F+$80
 DFB "N",$0E+$80
 DFB "F",$52+$80
 DFB "M",$53+$80
 DFB "L",$56,$50+$80
 DFB "H",$57,$50+$80
 DFB "D",$57,$50,$5E,$0D+$80
 DFB $FF 

****************************************
* BANKTABL IS USED BY BANKCHEK SUBROUTINE
* TO DETERMINE WHICH BANK THE CURRENT PC IS IN.
*
* PATTERN: AABBCC
* AA= LOWER LIMIT OF PC HI BYTE
* BB= PATTERN TO LOOK FOR IN MSTATE
* CC= BIT=0=DON'T CARE 
****************************************

 HEX 000000  ;LOWEST LIMIT
BANKTABL   ;MSTATE BIT CONDITION
 HEX 008080  ;7=1
 HEX 024040  ;6=1
 HEX 044042  ;6=1 1=0
 HEX 040606  ;2=1 1=1
 HEX 084040  ;6=1
 HEX 204060  ;6=1 5=0
 HEX 204444  ;6=1 2=1
 HEX 204042  ;6=1 1=0
 HEX 202626  ;5=1 2=1 1=1
 HEX 404040  ;6=1
 HEX C10101  ;0=1
 HEX D08080  ;7=1

**** EFFECTIVE ADDRESS ROUTINES

EFFTABL DA NOEFF-1  ;MODE 0 (IMED) NO EFF ADRS
 DA BANKEFF-1 ;MODE 1 (ABS) CALC EFF BANK ONLY
 DA NOEFF-1  ;MODE 2 (ABS.L) USE AS IS
 DA BANKEFF-1 ;MODE 3 (DIR) CALC EFF BANK ONLY
 DA NOEFF-1  ;MODE 4	(ACC;IMP;STK) NO EFF ADRS
 DA EFFM5-1  ;MODE 5
 DA EFFM6-1  ;MODE 6
 DA EFFM7-1  ;MODE 7
 DA EFFM8-1  ;MODE 8
 DA EFFM9-1  ;MODE 9
 DA EFFMA-1  ;MODE A
 DA EFFMB-1  ;MODE B
 DA EFFMC-1  ;MODE C
 DA NOEFF-1  ;MODE D NOT USED
 DA NOEFF-1  ;MODE E NOT USED
 DA EFFMF-1  ;MODE F
 DA EFFM10-1 ;MODE $10
 DA EFFM11-1 ;MODE $11
 DA EFFM12-1 ;MODE $12
 DA EFFM13-1 ;MODE $13
 DA EFFM14-1 ;MODE $14

****************************************
* THIS POINT MUST BE $CA00 OR ABOVE.
****************************************

 DS $CA00-*,$FF

******************************
*  COMD> - SKIP NEXT INSTRUCTION
******************************

COMDSKIP
 SEC   ;ADD EXTRA 1
 LDA NUMDISP  ;# BYTES IN CURRENT INST - 1
 ADC PCLO  ;SKIP IT
 STA PCLO
 LDA PCHI
 ADC #0  ;ADD CARRY IF ANY
 STA PCHI

 JSR WRINIT4
:MORE LDA MSGSKIP,Y ;DISPLAY "SKIP"
 JSR WRITECK4
 BCC :MORE

 JSR TRANSFR4 ;DISPLAY NEW LOCATION
 DFB INITDISRC ;code
 LDA #$80
 STA TFLAG  ;RESTORE TRACE MODE
 JMP MAIN104

******************************
*  COMDKEY - SET KEY
******************************

COMDKEY JSR WRINIT4  ;DISPLAY "KEY = "
:MORE LDA MSGKEY,Y ;GET CHAR
 JSR WRITECK4 ;DISPLAY
 BCC :MORE
 JSR TRANSFR4 ;READ KEYBOARD
 DFB RDCHARC  ;code
 STA KEY  ;SET KEY
 JMP MAIN104

ERROR4 LDA #BADPAR  ;ERROR NUMBER
 JSR TRANSFR4 ;DO ERROR
 DFB ERRBEEPC ;code
 JMP MAIN104

******************************
*  COMDSS - SET SWITCH
******************************

COMDSS BEQ ERROR4
 JSR TRANSFR4 ;READ ADDRESS INTO LETTER 1
 DFB CHKREADC ;code
 BCS ERROR4  ;IF NOT VALID
 JSR TRANSFR4 ;RESTORE CURRENT SWITCHES
 DFB RESTTEXTC ;code
 LDA ALTZP  ;CURRENT ALTZP STATUS
 STA INDYBUF  ;SAVE
* WATCH OUT FOR CX ROM
 LDA LETTER1
 CMP #$06  ;TURN CXROM OFF?
 BEQ :CXOFF  ;IF YES
 CMP #$07  ;TURN CXROM ON?
 BNE :NOTCX  ;IF NO
*CXON
 SEC
 BCS :SETCX
:CXOFF CLC   ;CX OFF
:SETCX ROR CXSTATUS ;SET CX
 JMP :SET  ;CONTINUE

:NOTCX TAX
 STA $C000,X  ;SET SWITCH
 LDA $C000,X  ;NEEDED FOR LANGUAGE CARD SWITCH
 LDA $C000,X  ; ditto

* DID WE JUST SWITCH STACKS ?
 LDA INDYBUF  ;OLD ALTZP
 EOR ALTZP  ;IS IT CHANGED ?
 BPL :SET  ;IF NOT

* SAVE NEW STACK TO EXT STACK BUFFER
 LDA #$FF
 PHA   ;NUMBER OF BYTES TO SAVE
 LDX STACK  ;STACK POINTER
 LDY SLOTN0
**********************************
* WARNING, SEGMENT DEPENDENT CODE 		
**********************************
 LDA #%01110100 ;RAM 7, ROM 4
 STA SEGMBASE,Y

 STY YREG  ;SAVE IN RAM7
 PLA   ;NUMBER OF BYTES TO SAVE
 TAY
:NEXT INX
 LDA $0100,X  ;GET FROM STACK
 STA STACKBUF,X ;SAVE IN EXT STACK BUFFER
 DEY
 BNE :NEXT

 LDY YREG  ;SLOTN0
***********************************
* WARNING, SEGMENT DEPENDENT CODE
***********************************
 LDA #%00000100 ;RAM 0, ROM 4
 STA SEGMBASE,Y

:SET JSR TRANSFR4 ;SAVE NEW SWITCHES
 DFB ZPAGSAVEC ;code
* UPDATE RAMRD AND RAMWRT BUFFERS
 LDA RAMRD  ;AUX OR MAIN READ
 STA RAMRDBF
 LDA RAMWRT  ;AUX OR MAIN WRITE
 STA RAMWRTBF

* RECALCULATE BANK
 JSR BANKCHEK
 STA PBR

 JSR TRANSFR4 ;RESET SCREEN SWITCHES
 DFB SETSCRNC ;code
 JSR TRANSFR4 ;UPDATE DISPLAY
 DFB DISFMESC ;code
 JSR TRANSFR4 ;SET WINDDR
 DFB WINDDRC  ;code
 JMP MAIN104

* DISPLAY BRANCH OUT OF RANGE

DISBROUT
 JSR WRINIT4
:MORE LDA MSGBROUT,Y ;GET CHAR
 JSR WRITECK4 ;DISPLAY
 BCC :MORE
 RTS

* DISPLAY NOT RAM MESSAGE

DISNOTRM
 JSR WRINIT4
:MORE LDA MSGNOTRM,Y ;GET CHAR
 JSR WRITECK4 ;DISPLAY
 BCC :MORE
 RTS

* DISPLAY HARDWARE

DISHARD
 JSR WRINIT4
:MORE LDA MSGHARD,Y ;GET CHAR
 JSR WRITECK4 ;DISPLAY
 BCC :MORE
 RTS

OUTPRGR
* IF PC IS IN OUR SLOT I/O SPACE THEN IT'S OK
 LDA PCHI
 CMP #$C0
 BNE :NOTOK
 LDA SLOTN0
 CLC
 ADC #$8F  ;OUR SLOT I/O LOWER BYTE
 CMP PCLO
 BLT :NOTOK
 SBC #$10
 CMP PCLO
 BLT :OK  ;C=0 IF OK
 
:NOTOK JSR WRINIT4
:MORE LDA MSGORNG,Y ;GET CHAR
 JSR WRITECK4 ;DISPLAY
 BCC :MORE
:OK RTS

NOACMSG JSR WRINIT4
:MORE LDA MSGNOAC,Y ;GET CHAR
 JSR WRITECK4 ;DISPLAY
 BCC :MORE
 RTS

* THIS ROUTINE MUST BE ABOVE $CF00

WRINIT4 STY YBUFF  ;SAVE
 LDY #0
WRITMOR4
 BIT $C800  ;DISABLE EXT RAM
 CLC
 RTS
WRITECK4
 BIT $CF00  ;ENABLE EXT RAM
 INY   ;NEXT CHARACTER
 CMP #EOT  ;FINISHED?
 BEQ WRITDON4 ;IF YES, CARRY ALSO SET
 JSR TRANSFR4 ;DISPLAY CHARACTER
 DFB COUTC  ;CODE
 JMP WRITMOR4
WRITDON4
 LDY YBUFF  ;RESTORE
 RTS

* INITIALIZE THE DISPLAY WINDOW TO FULL SCREEN

WINDFUL LDA #0
 STA WINDLEFT
 STA WINDTOP
 STA CURSHORZ
 LDA #80
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR TRANSFR4 ;SET BASL & CLEAR HOME
 DFB CLRHOMEC ;CODE

 SEC
 ROR WINDFLG  ;indicate windows are off
 
 RTS

******************************
* COMDSD - SET DISPLAY SWITCH
******************************

COMDSD BEQ SDERR  ;IF NO CHAR FOLLOWS

* SET THE DISPLAY SWITCHES
* ACC CONTAINS COMMAND LETTER

 LDX #0
 STA SELFMOD  ;SAVE COMMAND LETTER
 STA $C800  ;SELECT EXT ROM
 LDA DISPTABL,X ;GET COMMAND LETTER FROM TABLE
 STA $CF00  ;SELECT EXT RAM
:LOOK CMP SELFMOD  ;IS IT THIS COMMAND
 BEQ MATCH  ;IF YES
 STA $C800  ;SELECT EXT ROM
:LOOP INX
 LDA DISPTABL,X ;GO TO NEXT COMMAND LETTER
 BPL :LOOP
 INX
 LDA DISPTABL,X
 STA $CF00  ;SELECT EXT RAM
 CMP #$FF  ;END OF TABLE ?
 BNE :LOOK  ;IF NO

SDERR JMP ERROR4  ;INDICATE ERROR & GOTO MAIN10

* SET THE PROPER SWITCHES
* USE SELF MODIFING CODE

MATCH LDA #$8D  ;STA abs OPCODE
 STA SELFMOD
 LDA #$C0  ;HI BYTE OF SWITCH ADDRESS
 STA SELFMOD+2
 LDA #$60  ;RTS OPCODE
 STA SELFMOD+3

 STX SELFMOD+1 ;SAVE
 LDA INVISIBL ;INVISIBLE MODE FLAG
 PHA   ;SAVE

* TURN EXT DISPLAY OFF
 JSR TRANSFR4 ;RESTORE TEXT & DISPLAY SWITCHES
 DFB RESTTEXTC ;code
 LDA #$80
 STA OFFFLAG  ;TURN OFF EXT DISPLAY

:ISOFF LDA #0
 STA INVISIBL ;CLEAR IF SET
 JSR TRANSFR4 ;RESTORE DISPLAY SWITCHES
 DFB RESTDISPC ;code
 LDX SELFMOD+1 ;RESTORE

:NEXTS STA $C800  ;SELECT EXT ROM
 INX
 LDA DISPTABL,X ;LOW BYTE OF SWITCH
 STA $CF00  ;SELECT EXT RAM
 PHP   ;SAVE N FLAG
 AND #$7F  ;STRIP BIT 7
 STA SELFMOD+1 ;PUT IN ROUTINE
 JSR SELFMOD  ;SET SWITCH
 PLP   ;WAS IT LAST SWITCH
 BPL :NEXTS  ;IF NO
 JSR TRANSFR4 ;SAVE NEW DISPLAY SWITCHES
 DFB SAVEDISPC ;code
 PLA   ;GET INVISIBL MODE FLAG
 STA INVISIBL ;RESTORE
 JMP MAIN104

******************************
* COMDPW - PROTECTION WINDOW
******************************

COMDPW LDX #5*6  ;0-5 BUFFFERS 6 BYTES EACH BUFFER
 STX LETTER1  ;SAVE
 JSR TRANSFR4 ;DISPLAY PROT WINDOW
 DFB DISPROTWC ;code
 JSR TRANSFR4 ;HOME
 DFB HOMEC  ;code
 LDA #$A0  ;SPACE
 STA PROMPT
PWINPUT LDA IOMODE  ;ARE WE IN SERIAL or printer MODE ?
 BEQ :NOSER  ;IF NOT
* DISPLAY CURRENT PW INFO IF SERIAL OR PRINTER
 LDX LETTER1
 LDA PROTADR,X ;GET PROTECTION TYPE
 JSR TRANSFR4 ;DISPLAY
 DFB COUTC  ;code
 LDA PROTADR+1,X
 JSR TRANSFR4 ;PRINT BYTE
 DFB PRBYTEC  ;code
 LDA #"/"
 JSR TRANSFR4
 DFB COUTC
 LDA PROTADR+2,X
 JSR TRANSFR4
 DFB PRBYTEC  ;code
 LDA PROTADR+3,X
 JSR TRANSFR4
 DFB PRBYTEC  ;code
 LDA #"."
 JSR TRANSFR4
 DFB COUTC  ;code
 LDA PROTADR+4,X
 JSR TRANSFR4
 DFB PRBYTEC  ;code
 LDA PROTADR+5,X
 JSR TRANSFR4
 DFB PRBYTEC  ;code	
 LDA #" "
 JSR TRANSFR4
 DFB COUTC  ;code

:NOSER JSR TRANSFR4 ;GET LINE
 DFB GETLNC  ;code
 BCS :END ;if <esc> key
 INX
 STX TEMP  ;IN POINTER
 LDY #0
 JSR GETCHAR  ;GET FROM IN,Y
 BEQ :CR  ;IF <CR>
 CMP #"T"  ;TRACE RANGE ?
 BEQ :SAVETYPE ;IF YES
 CMP #"P"  ;PROGRAM ONLY RANGE ?
 BEQ :SAVETYPE ;IF YES
 CMP #"N"  ;NO ACCESS RANGE ?
 BEQ :SAVETYPE ;IF YES
 CMP #$A0  ;SPACE MEANS REMOVE TYPE
 BNE :ERROR  ;IF NO
:SAVETYPE
 LDX LETTER1  ;PROTADR POINTER
 STA PROTADR,X ;SAVE TYPE
* LOAD IN 1 BYTE OF PROTADR ADDRESS, LOOP UNTIL DONE
:PRBYT INX   ;NEXT BYTE
 JSR GETCHAR  ;READ IN,Y
 BEQ :CR  ;IF <CR>
 JSR CHKHEX  ;CONVERT TO HEX
 BCS :ERROR  ;IF NOT HEX
 JSR MSNYBPW  ;UPDATE MS NYBBLE OF DATA
 JSR GETCHAR  ;READ IN,Y
 BEQ :CR
 JSR CHKHEX
 BCS :ERROR
 JSR LSNYBPW  ;UPDATE LS NYBBLE OF DATA
 CPY #3  ;SKIP "/" ?
 BEQ :SKIP  ;IF YES
 CPY #8  ;SKIP "." ?
 BNE :PRBYT
:SKIP JSR GETCHAR
 BEQ :CR
 BNE :PRBYT
:ERROR JSR TRANSFR4 ;RING BELL
 DFB BELLC  ;code
:CR LDA CURSVERT ;SAVE CURRENT POSITION
 PHA
 JSR TRANSFR4 ;UPDATE PROT WINDOW
 DFB DISPROTWC ;code
 PLA
 STA CURSVERT ;RESTORE POSITION
 LDA #0
 STA CURSHORZ ;LEFT EDGE
 JSR TRANSFR4 ;RESTORE BAS
 DFB VTABC  ;code
 LDX LETTER1  ;PROTADR POINTER
 BNE :CONT ;IF ALL DONE
 JMP COMDPW ;loop when bottom reached
:CONT SEC
 TXA
 SBC #6  ;GOTO NEXT LOCATION
 STA LETTER1
 JMP PWINPUT  ;LOOP

* SET PROPER FLAGS & LEAVE
:END LDA #0
 STA REALTIME ;CLEAR ALL FLAGS
 STA PROGONLY
 STA NOACCESS
 LDX #6*5
:SETFLG LDA PROTADR,X ;GET TYPE
 CMP #"T"
 BNE :CHKP
 STA REALTIME ;SET FLAG
:CHKP CMP #"P"
 BNE :CHKN
 STA PROGONLY ;SET FLAG
:CHKN CMP #"N"
 BNE :NEXTTYP
 STA NOACCESS ;SET FLAG
:NEXTTYP
 TXA
 BEQ :LEAVE
 SEC
 SBC #6  ;NEXT TYPE
 TAX
 BCS :SETFLG  ;<ALWAYS>

:LEAVE JSR TRANSFR4 ;DISPLAY PROT WINDOW
 DFB DISPROTWC ;code
 JSR TRANSFR4 ;SET DR WINDOW
 DFB WINDDRC  ;code

 JMP MAIN104

* UPDATE THE MS NYBBLE OF DATA BYTE

MSNYBPW ASL
 ASL
 ASL
 ASL
 PHA   ;SAVE DIGIT
 LDA #$0F
 BNE STRIP

* UPDATE THE LS NYBBLE OF DATA BYTE

LSNYBPW PHA   ;SAVE DIGIT
 LDA #$F0
STRIP AND PROTADR,X ;STRIP DIGIT
 STA PROTADR,X
 PLA   ;GET NEW DIGIT
 ORA PROTADR,X
 STA PROTADR,X ;PUT IN
 RTS

* CONVERT ACC TO HEX

CHKHEX CMP #$B0
 BLT :NOTHEX
 CMP #$BA
 BLT :OK
 CMP #$C0
 BLT :NOTHEX
 CMP #$C7
 BLT :OKAF
:NOTHEX SEC   ;SET NOT HEX FLAG
 RTS

:OKAF CLC
 ADC #9  ;CONVERT TO $A - $F
:OK AND #$0F  ;STRIP HI DIGIT
 CLC   ;SET HEX FLAG
 RTS

GETCHAR LDA IN,Y ;READ CHAR
 INY
 DEC TEMP ;IN POINTER
 RTS

******************************
* COMDMW - MEMORY WINDOW
******************************

COMDMW JSR TRANSFR4 ;SET MEM WINDOW
 DFB DISMEMWC ;code
:MWLOOP JSR TRANSFR4 ;HOME W/NO CLEAR
 DFB HOMEC  ;code

* SET WINDOW WIDTH TO FORCE RETURN AT END OF ADDRESS
 LDA #8
 STA WINDWDTH
 LDX #11*3  ;0-11 BUFFFERS 3 BYTES EACH BUFFER
 STX LETTER1  ;SAVE

 LDA #$80  ;NULL
 STA PROMPT
:MWINPUT JSR TRANSFR4 ;GET LINE
 DFB GETLNC  ;code
 BCS :END  ;if <esc> key pressed
 INX
 STX TEMP  ;IN POINTER
 LDY #0

 LDX LETTER1  ;MEM ADDRESS POINTER
 DEX

* LOAD IN 1 BYTE OF MEMADR ADDRESS, LOOP UNTIL DONE
:PRBYT INX   ;NEXT BYTE
 JSR GETCHAR  ;READ IN,Y
 BEQ :CR  ;IF <CR>
 JSR CHKHEX  ;CONVERT TO HEX
 BCS :ERROR  ;IF NOT HEX
 JSR ASLUPMW  ;UPDATE MS NYBBLE OF DATA
 JSR GETCHAR  ;READ IN,Y
 BEQ :CR
 JSR CHKHEX
 BCS :ERROR
 JSR UPDTMW  ;UPDATE LS NYBBLE OF DATA
 CPY #2  ;SKIP "/" ?
 BNE :PRBYT  ;IF NO
:SKIP JSR GETCHAR
 BEQ :CR
 BNE :PRBYT  ;<ALWAYS>
:ERROR JSR TRANSFR4 ;RING BELL
 DFB BELLC  ;code
:CR LDA CURSVERT ;SAVE CURRENT POSITION
 PHA
 JSR TRANSFR4 ;UPDATE PROT WINDOW
 DFB DISMEMWC ;code
 LDA #8
 STA WINDWDTH ;RESET WINDOW WIDTH
 PLA
 STA CURSVERT ;RESTORE POSITION
 LDA #0
 STA CURSHORZ ;LEFT EDGE
 JSR TRANSFR4 ;RESTORE BAS
 DFB VTABC  ;code
 LDX LETTER1  ;MEMADR POINTER
 BEQ :MWLOOP ;if at bottom of window
 SEC
 TXA
 SBC #3  ;GOTO NEXT LOCATION
 STA LETTER1
 JMP :MWINPUT  ;LOOP

:END JSR TRANSFR4 ;UPDATE MW DISPLAY
 DFB DISMEMWC ;code
 JSR TRANSFR4 ;SET DR WINDOW
 DFB WINDDRC ;code

 JMP MAIN104 

* UPDATE HI NYBBLE OF MEMWADR

ASLUPMW ASL
 ASL
 ASL
 ASL
 PHA   ;SAVE DIGIT
 LDA #$0F
 BNE STRIPMW

* UPDATE LOW NYBBLE OF MEMWADR

UPDTMW PHA   ;SAVE DIGIT
 LDA #$F0
STRIPMW AND MEMWADR,X ;STRIP DIGIT
 STA MEMWADR,X
 PLA   ;GET NEW DIGIT
 ORA MEMWADR,X
 STA MEMWADR,X ;PUT IN
 RTS

****************************************
* CALCULATE THE BANK FOR THE CURRENT
* MEMLOW & MEMHI LOCATION
*
* LOCATION MSTATE CONTAINS THE MEMORY STATE BYTE. USE THIS TO
* DETERMINE IF CURRENT MEMLOW & MEMHI LOCATION IS IN MAIN OR
* AUX MEMORY. MODIFY MSTATE BYTE FOR THIS TEST, MAKE BIT5=HIRES
*****************************************

BANKCHEK
 LDA HIRESFLG
 AND #$80
 LSR
 LSR   ;PUT IN BIT 5
 EOR MSTATE
 AND #$20
 EOR MSTATE  ;BIT5 = HIRES
 STA TEMP
 LDX #$21
 LDA MEMHI  ;HI BYTE OF PC
 CMP #$C0
 BEQ MAINRAM
MATCHPC LDA MEMHI  ;HI BYTE OF PC
 CMP $C800
 CMP BANKTABL,X
 STA $CF00
 BLT NOTAUX  ;TRY NEXT LIMIT

 LDA TEMP  ;GET MSTATE WITH MOD. BIT 5
 CMP $C800
 EOR BANKTABL+1,X ;XOR WITH TEST BYTE
 AND BANKTABL+2,X ;AND WITH TEST BYTE
 BEQ ISAUX  ;IF =0 THEN AUX RAM

* IF NOT AUX RAM, SHOULD WE USE THE NEXT BANKTABL FLAGS
 LDA BANKTABL-3,X ;GET NEXT BANKTABL LOWER LIMIT
 CMP BANKTABL,X ;SAME AS CURRENT LIMIT ?
 STA $CF00  ;ENAB EXT RAM
 BNE MAINRAM  ;IF NO

NOTAUX DEX
 DEX
 DEX
 BPL MATCHPC
MAINRAM
 LDA #0
 BEQ BANKSET

* IF AUX RAM
ISAUX STA $CF00  ;ENABLE EXT RAM
 LDA #01
BANKSET STA MEMPBR  ;SET BANK
 RTS   ;LEAVE

*----------------------------------------
* CALCULATE BANK # OF EFFECTIVE ADDRESS
* EFFADRS+2, +1, +0 = EFFECTIVE PBR, HI, LOW RESPECTIVELY

BANKEFF PHP   ;SAVE CARRY 
 LDA MEMPBR
 PHA
 LDA MEMHI  ;SAVE MEMPBR & MEMHI
 PHA
 LDA EFFADRS+1 ;GET HI BYTE OF EFF ADRS
 STA MEMHI  ;SET UP MEMHI FOR BANKCHEK
 JSR BANKCHEK ;CALCULATE BANK #
 STA EFFADRS+2 ;SAVE BANK # OF EFFADRS
 PLA
 STA MEMHI
 PLA
 STA MEMPBR  ;RESTORE MEMHI & MEMPBR
 PLP   ;RESTORE CARRY
 RTS

* ----------------------------------------
** CALCULATE THE EFFECTIVE ADDRESS OF CURRENT INSTRUCTION

CALCEFF SEC
 LDX MODE  ;GET MODE * 2
 CMP $C800  ;SELECT EXT ROM
 LDA EFFTABL+1,X ;GET HI BYTE OF PROPER ROUTINE
 PHA
 LDA EFFTABL,X ;GET LOW BYTE OF ROUTINE
 PHA
 CMP $CF00  ;SELECT EXT RAM
 CLC
NOEFF RTS   ;GOTO ROUTINE WITH RTS

* CALCULATE EFFECTIVE ADDRESS ROUTINES

* MODE 5  (d),Y

EFFM5 LDX EFFADRS  ;GET OPERAND
 LDA YREG  ;USERS Y
 ADC 0,X  ;ADD d TO Y
 STA EFFADRS
 LDA 1,X  ;HI BYTE d
EFFADC ADC #0  ;ADD CARRY IF ANY
EFFSTA STA EFFADRS+1
 JMP BANKEFF  ;CALC BANK OF EFF ADDRESS & RTS

* MODE 6  [d],Y

EFFM6 JSR EFFM5
 LDA 2,X  ;PBR OF d
EFFADC2 ADC #0
 STA EFFADRS+2
 RTS

* MODE 8  d,X

EFFM8 LDA XREG  ;USERS X
M9CONT ADC EFFADRS  ;ADD X TO OPERAND
 STA EFFADRS
 JMP BANKEFF  ;CALC BANK # & RTS

* MODE 9  d,Y

EFFM9 LDA YREG  ;USERS Y
 BCC M9CONT  ;<always>

* MODE 7 (d,X)

EFFM7 LDA XREG  ;USER'S X
 ADC EFFADRS  ;ADD X TO OPERAND
 TAX
M7CONT LDA 0,X  ;LOW BYTE EFFADRS
 STA EFFADRS
 LDA 1,X
 JMP EFFSTA

* MODE 10  (d)

EFFM10 LDX EFFADRS  ;GET OPERAND
 BCC M7CONT  ;<always>

* MODE A  a,X

EFFMA LDA XREG  ;USERS X
MCCONT ADC EFFADRS  ;LOW BYTE
 STA EFFADRS
 LDA EFFADRS+1 ;HI BYTE
 JMP EFFADC

* MODE B  al,X

EFFMB LDA EFFADRS+2
 PHA
 JSR EFFMA
 PLA
 JMP EFFADC2

* MODE C  a,Y

EFFMC LDA YREG  ;USERS Y
 BCC MCCONT

* MODE F  (a)

EFFMF LDA #$BD  ;LDA	OP,X OPCODE
 STA SELFMOD  ;SETUP SELF MOD
 LDA EFFADRS
 STA SELFMOD+1
 LDA EFFADRS+1
 STA SELFMOD+2
 LDA #$60  ;RTS OPCODE
 STA SELFMOD+3
 LDX #0
 JSR SELFMOD  ;GET LOW BYTE IND ADRS
 STA EFFADRS
 INX
 JSR SELFMOD  ;GET HI BYTE IND ADRS
 JMP EFFSTA

* MODE 12  (a,X)

EFFM12 LDA XREG  ;USERS X REG
 ADC EFFADRS  ;ADD TO OPERAND
 STA EFFADRS
 LDA EFFADRS+1
 ADC #0
 STA EFFADRS+1
 JMP EFFMF

* MODE 11  [d]

EFFM11 JSR EFFM10
 LDA 2,X  ;GET PBR IND ADRS
 STA EFFADRS+2
 RTS

* MODE 13  d,S

EFFM13 LDA STACK  ;LOW BYTE STACK
 ADC EFFADRS  ;ADD TO OPERAND
 STA EFFADRS
 LDA STACK+1  ;HI BYTE STACK
 JMP EFFADC

* MODE 14  (d,S),Y ** NOT COMPLETED YET **

EFFM14 JSR EFFM13
 RTS

******************************
* PART OF COMDRT

SETUPRT LDA #%10111111
 STA RTBRKFLG ;SET FLAG >$7F
 AND IERBUFF
 STA IERBUFF  ;DISABLE VIAT1 INTERRUPT
 LDX STACK  ;USERS STACK
* SEE IF A PRODOS MLI CALL WAS THE LAST JSR EXECUTED
 INX   ;POINT TO LOW BYTE OF RTS ADDRESS
 SEC
 LDA $100,X  ;GET LOW BYTE OF RETURN ADDRESS
 SBC #2  ;POINT TO JSR OPCODE
 STA LOWADD
 INX
 LDA $100,X  ;GET HI BYTE OF RETURN ADDRESS
 SBC #0
 STA HIADD
 LDY #0

* TEST FOR JSR $BF00
 JSR TRANSFR4
 DFB LDAINDYC ;code
 CMP #$20
 BNE :NOTMLI
 INY
 JSR TRANSFR4
 DFB LDAINDYC ;code
 BNE :NOTMLI  ;IF NOT $00
 INY
 JSR TRANSFR4
 DFB LDAINDYC ;code
 CMP #$BF
 BEQ :MLI  ;IF MLI CALL

:NOTMLI LDY #$FF  ;NOT MLI SO PUT BRK AT NEXT INSTRUCTION

* It is a ProDos MLI call, so place a BRK at the instruction
* following the MLI parameters.
:MLI INY
 INY
 INY
 INY   ;POINT TO OPCODE OF NEXT INST.
 JSR TRANSFR4 ;GET OPCODE
 DFB LDAINDYC ;code
 BEQ :ISBRK  ;IT IS A BRK, SO DON'T ALLOW REAL TIME
 STA RTOPCODE ;SAVE OPCODE
 LDA #0
 JSR TRANSFR4 ;PUT BRK
 DFB STAINDYC ;code
 JSR TRANSFR4 ;VERIFY
 DFB LDAINDYC ;code
 BEQ :CONTINUE ;IF OK
* BRK DID NOT STORE
:ISBRK RTS   ;Z=1 IF ALREADY BRK, Z=0 IF NOT RAM

:CONTINUE
 LDX STACK
 INX
 INX   ;THIS IS WHERE STACK POINTER WILL BE AFTER
 STX RTSTK  ; RTS & HITTING OUR BRK.

 JSR TRANSFR4 ;START REALTIME
 DFB EXECUTEC ;code
* NO RETURN

* RESTORE AFTER REALTIME BRK

RESTRT LDA RTOPCODE ;GET SAVED OPCODE
 LDY #0
 JSR TRANSFR4 ;RESTORE OPCODE AT CURRENT PC
 DFB STAPCIYC ;code

 STY RTBRKFLG ;CLEAR FLAG
 STY PASSFLG  ;NOT REALLY A BRK
 BIT COMRTFLG ;IS THIS COMDRT ?
 RTS

******* SAVE THE ACC, X AND P REGISTERS *****

SAVEAXP4
 PHP   ;SAVE STATUS
 STX XSAVESEG
 STA ASAVESEG
 PLA   ;GET STATUS
 STA PSAVESEG ;SAVE
 RTS

****** RESTORE THE ACC, X AND P REGISTERS *****

RESTAXP4
 LDX XSAVESEG
 LDA PSAVESEG
 PHA
 LDA ASAVESEG
 PLP
 RTS

***** THIS SEGMENTS GLOBAL SUBROUTINES *****

SUBTABL4

DISBROUTC EQU *-SUBTABL4*4+4+$100
 DA DISBROUT-1

DISNOTRMC EQU *-SUBTABL4*4+4+$100
 DA DISNOTRM-1

DISHARDC EQU *-SUBTABL4*4+4+$100
 DA DISHARD-1

OUTPRGRC EQU *-SUBTABL4*4+4+$100
 DA OUTPRGR-1

NOACMSGC EQU *-SUBTABL4*4+4+$100
 DA NOACMSG-1

WINDFULC EQU *-SUBTABL4*4+4+$100
 DA WINDFUL-1

BANKCHEKC EQU *-SUBTABL4*4+4+$100
 DA BANKCHEK-1

CALCEFFC EQU *-SUBTABL4*4+4+$100
 DA CALCEFF-1

SETUPRTC EQU *-SUBTABL4*4+4+$100
 DA SETUPRT-1

RESTRTC EQU *-SUBTABL4*4+4+$100
 DA RESTRT-1

*********************************
**** SEGMENT CROSSOVER AREA *****
*********************************

 LST ON
S4END = $CF9D-*
 do nolist
 LST OFF
 fin
 ERR *-1/$CF9D
 DS $CF9D-*,$FF

MAIN104 JSR SAVEAXP4 ;COME HERE TO TRANSFER TO SEGMENT0 DIRECTLY
 LDX SLOTN0
 LDA #%00000101 ;RAM0,ROM5
 STA SEGMBASE,X ;NEXT INSTRUCTION EXECUTED FROM SEGMENT 5
 JSR RESTAXP4 ;RESTORE AFTER TRANSFER FROM SEGMENT 5
 RTS   ;GOTO COMMANDS IN THIS SEGMENT
 NOP
 NOP   ;MATCH LENGTH WITH SEG 5

* TRANSFER TO OTHER SEGMENTS

TRANSFR4

 JSR SAVEAXP4
 PLA   ;GET RETRUN ADDRESS FROM STACK
 CLC
 ADC #1  ;INC TO POINT AT CODE BYTE
 STA TEMPSEG  ;SETUP LDA TEMPSEG ROUTINE
 PLA
 ADC #0  ;ADD CARRY, IF ANY
 STA TEMPSEG+1 ;SETUP LDA TEMPSEG ROUTINE
 PHA
 LDA TEMPSEG
 PHA   ;BUMP RETURN ADDRESS PAST CODE BYTE
 LDA #4  ;CURRENT SEG #
 PHA
 JSR LDATEMP  ;LOAD CODE BYTE
 STA SEGMCODE ;SAVE CODE
 AND #$07  ;STRIP ALL BUT SEG #
 LDX SLOTN0
 STA SEGMBASE,X ;NEXT INSTR. RUN FROM NEW SEGMENT
* NEW SEGMENT
 LDA #>RETURN4 ;WHERE TO RETURN TO
 PHA
 LDA #RETURN4
 PHA
 LDA SEGMCODE ;CODE BYTE
 AND #$F8  ;STIP OFF SEG# LEAVING SUB #
 LSR
 LSR   ;LEAVE SUB# MULTIPLIED BY 2
* GET ADDRESS OF SUB FROM SUBTABL & PUSH ON STACK
 TAX
 LDA SUBTABL4+1,X
 PHA
 LDA SUBTABL4,X
 PHA

 JSR RESTAXP4 ;RESTORE REGISTERS
 RTS   ;USE RTS TO GOTO SUB

* RETURN HERE FROM SUBROUTINE

RETURN4 EQU *-1
 JSR SAVEAXP4
 PLA   ;SEG # TO RETURN TO
 LDX SLOTN0
 STA SEGMBASE,X ;RETURN TO SEGMENT
 JSR RESTAXP4
 RTS   ;RETURN TO PROGRAM

 DS \,$FF ;PUT OBJECT AT NEXT PAGE
